home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / MPW / fsplit 1.1.1 / fsplit.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-04-30  |  9.3 KB  |  406 lines  |  [TEXT/MPS ]
  1. /*
  2.  * Copyright (c) 1983 The Regents of the University of California.
  3.  * All rights reserved.
  4.  *
  5.  * This code is derived from software contributed to Berkeley by
  6.  * Asa Romberger and Jerry Berkman.
  7.  *
  8.  * Redistribution and use in source and binary forms are permitted
  9.  * provided that: (1) source distributions retain this entire copyright
  10.  * notice and comment, and (2) distributions including binaries display
  11.  * the following acknowledgement:  ``This product includes software
  12.  * developed by the University of California, Berkeley and its contributors''
  13.  * in the documentation or other materials provided with the distribution
  14.  * and in all advertising materials mentioning features or use of this
  15.  * software. Neither the name of the University nor the names of its
  16.  * contributors may be used to endorse or promote products derived
  17.  * from this software without specific prior written permission.
  18.  * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
  19.  * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
  20.  * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  21.  */
  22.  
  23. #ifndef lint
  24. char copyright[] =
  25. "@(#) Copyright (c) 1983 The Regents of the University of California.\n\
  26.  All rights reserved.\n";
  27. #endif /* not lint */
  28.  
  29. #ifndef lint
  30. static char sccsid[] = "@(#)fsplit.c    5.4 (Berkeley) 6/1/90";
  31. #endif /* not lint */
  32.  
  33. #include <ctype.h>
  34. #include <stdio.h>
  35. #include <sys/types.h>
  36. #include <sys/stat.h>
  37.  
  38. /*
  39.  *    usage:        fsplit [-e efile] ... [file]
  40.  *
  41.  *    split single file containing source for several fortran programs
  42.  *        and/or subprograms into files each containing one
  43.  *        subprogram unit.
  44.  *    each separate file will be named using the corresponding subroutine,
  45.  *        function, block data or program name if one is found; otherwise
  46.  *        the name will be of the form mainNNN.f or blkdtaNNN.f .
  47.  *        If a file of that name exists, it is saved in a name of the
  48.  *        form zzz000.f .
  49.  *    If -e option is used, then only those subprograms named in the -e
  50.  *        option are split off; e.g.:
  51.  *            fsplit -esub1 -e sub2 prog.f
  52.  *        isolates sub1 and sub2 in sub1.f and sub2.f.  The space 
  53.  *        after -e is optional.
  54.  *
  55.  *    Modified Feb., 1983 by Jerry Berkman, Computing Services, U.C. Berkeley.
  56.  *        - added comments
  57.  *        - more function types: double complex, character*(*), etc.
  58.  *        - fixed minor bugs
  59.  *        - instead of all unnamed going into zNNN.f, put mains in
  60.  *          mainNNN.f, block datas in blkdtaNNN.f, dups in zzzNNN.f .
  61.  *
  62.  *    Modified Apr., 1993 by Fred Walsteijn (walsteyn@fys.ruu.nl), IMAU, Utrecht University, The Netherlands
  63.  *        - "register rv" changed to "register int rv"; "int argc" added.
  64.  *        - #ifdef MPW then polish for Macintosh/MPW Shell: setbuf() added (progress report
  65.  *          should not be buffered); further the Unix link()/unlink()-pair is then replaced
  66.  *          by the ANSI rename().
  67.  */
  68.  
  69. #define BSZ 512
  70. char buf[BSZ];
  71. FILE *ifp;
  72. char     x[]="zzz000.f",
  73.     mainp[]="main000.f",
  74.     blkp[]="blkdta000.f";
  75. char *look(), *skiplab(), *functs();
  76.  
  77. #define TRUE 1
  78. #define FALSE 0
  79. int    extr = FALSE,
  80.     extrknt = -1,
  81.     extrfnd[100];
  82. char    extrbuf[1000],
  83.     *extrnames[100];
  84. struct stat sbuf;
  85.  
  86. #define trim(p)    while (*p == ' ' || *p == '\t') p++
  87.  
  88. main(argc, argv)
  89. int argc;
  90. char **argv;
  91. {
  92.     register FILE *ofp;    /* output file */
  93.     register int rv;        /* 1 if got card in output file, 0 otherwise */
  94.     register char *ptr;
  95.     int nflag,        /* 1 if got name of subprog., 0 otherwise */
  96.         retval,
  97.         i;
  98.     char name[20],
  99.         *extrptr = extrbuf;
  100.  
  101. #ifdef MPW
  102.     setbuf(stdout,NULL);     /* fsplit works nicer in MPW Shell if stdout isn't buffered */
  103. #endif
  104.     /*  scan -e options */
  105.     while ( argc > 1  && argv[1][0] == '-' && argv[1][1] == 'e') {
  106.         extr = TRUE;
  107.         ptr = argv[1] + 2;
  108.         if(!*ptr) {
  109.             argc--;
  110.             argv++;
  111.             if(argc <= 1) badparms();
  112.             ptr = argv[1];
  113.         }
  114.         extrknt = extrknt + 1;
  115.         extrnames[extrknt] = extrptr;
  116.         extrfnd[extrknt] = FALSE;
  117.         while(*ptr) *extrptr++ = *ptr++;
  118.         *extrptr++ = 0;
  119.         argc--;
  120.         argv++;
  121.     }
  122.  
  123.     if (argc > 2)
  124.         badparms();
  125.     else if (argc == 2) {
  126.         if ((ifp = fopen(argv[1], "r")) == NULL) {
  127.             fprintf(stderr, "fsplit: cannot open %s\n", argv[1]);
  128.             exit(1);
  129.         }
  130.     }
  131.     else
  132.         ifp = stdin;
  133.     for(;;) {
  134.     /* look for a temp file that doesn't correspond to an existing file */
  135.     get_name(x, 3);
  136.     ofp = fopen(x, "w");
  137.     nflag = 0;
  138.     rv = 0;
  139.     while (getline() > 0) {
  140.         rv = 1;
  141.         fprintf(ofp, "%s", buf);
  142.         if (lend())        /* look for an 'end' statement */
  143.             break;
  144.         if (nflag == 0)        /* if no name yet, try and find one */
  145.             nflag = lname(name);
  146.     }
  147.     fclose(ofp);
  148.     if (rv == 0) {            /* no lines in file, forget the file */
  149.         unlink(x);
  150.         retval = 0;
  151.         for ( i = 0; i <= extrknt; i++ )
  152.             if(!extrfnd[i]) {
  153.                 retval = 1;
  154.                 fprintf( stderr, "fsplit: %s not found\n",
  155.                     extrnames[i]);
  156.             }
  157.         exit( retval );
  158.     }
  159.     if (nflag) {            /* rename the file */
  160.         if(saveit(name)) {
  161.             if (stat(name, &sbuf) < 0 ) {
  162. #ifndef MPW
  163.                 link(x, name);
  164.                 unlink(x);
  165. #else
  166.                 rename(x, name);
  167. #endif
  168.                 printf("%s\n", name);
  169.                 continue;
  170.             } else if (strcmp(name, x) == 0) {
  171.                 printf("%s\n", x);
  172.                 continue;
  173.             }
  174.             printf("%s already exists, put in %s\n", name, x);
  175.             continue;
  176.         } else
  177.             unlink(x);
  178.             continue;
  179.     }
  180.     if(!extr)
  181.         printf("%s\n", x);
  182.     else
  183.         unlink(x);
  184.     }
  185. }
  186.  
  187. badparms()
  188. {
  189.     fprintf(stderr, "fsplit: usage:  fsplit [-e efile] ... [file] \n");
  190.     exit(1);
  191. }
  192.  
  193. saveit(name)
  194. char *name;
  195. {
  196.     int i;
  197.     char    fname[50],
  198.         *fptr = fname;
  199.  
  200.     if(!extr) return(1);
  201.     while(*name) *fptr++ = *name++;
  202.     *--fptr = 0;
  203.     *--fptr = 0;
  204.     for ( i=0 ; i<=extrknt; i++ ) 
  205.         if( strcmp(fname, extrnames[i]) == 0 ) {
  206.             extrfnd[i] = TRUE;
  207.             return(1);
  208.         }
  209.     return(0);
  210. }
  211.  
  212. get_name(name, letters)
  213. char *name;
  214. int letters;
  215. {
  216.     register char *ptr;
  217.  
  218.     while (stat(name, &sbuf) >= 0) {
  219.         for (ptr = name + letters + 2; ptr >= name + letters; ptr--) {
  220.             (*ptr)++;
  221.             if (*ptr <= '9')
  222.                 break;
  223.             *ptr = '0';
  224.         }
  225.         if(ptr < name + letters) {
  226.             fprintf( stderr, "fsplit: ran out of file names\n");
  227.             exit(1);
  228.         }
  229.     }
  230. }
  231.  
  232. getline()
  233. {
  234.     register char *ptr;
  235.  
  236.     for (ptr = buf; ptr < &buf[BSZ]; ) {
  237.         *ptr = getc(ifp);
  238.         if (feof(ifp))
  239.             return (-1);
  240.         if (*ptr++ == '\n') {
  241.             *ptr = 0;
  242.             return (1);
  243.         }
  244.     }
  245.     while (getc(ifp) != '\n' && feof(ifp) == 0) ;
  246.     fprintf(stderr, "line truncated to %d characters\n", BSZ);
  247.     return (1);
  248. }
  249.  
  250. /* return 1 for 'end' alone on card (up to col. 72),  0 otherwise */
  251. lend()
  252. {
  253.     register char *p;
  254.  
  255.     if ((p = skiplab(buf)) == 0)
  256.         return (0);
  257.     trim(p);
  258.     if (*p != 'e' && *p != 'E') return(0);
  259.     p++;
  260.     trim(p);
  261.     if (*p != 'n' && *p != 'N') return(0);
  262.     p++;
  263.     trim(p);
  264.     if (*p != 'd' && *p != 'D') return(0);
  265.     p++;
  266.     trim(p);
  267.     if (p - buf >= 72 || *p == '\n')
  268.         return (1);
  269.     return (0);
  270. }
  271.  
  272. /*        check for keywords for subprograms    
  273.         return 0 if comment card, 1 if found
  274.         name and put in arg string. invent name for unnamed
  275.         block datas and main programs.        */
  276. lname(s)
  277. char *s;
  278. {
  279. #    define LINESIZE 80 
  280.     register char *ptr, *p, *sptr;
  281.     char    line[LINESIZE], *iptr = line;
  282.  
  283.     /* first check for comment cards */
  284.     if(buf[0] == 'c' || buf[0] == 'C' || buf[0] == '*') return(0);
  285.     ptr = buf;
  286.     while (*ptr == ' ' || *ptr == '\t') ptr++;
  287.     if(*ptr == '\n') return(0);
  288.  
  289.  
  290.     ptr = skiplab(buf);
  291.  
  292.     /*  copy to buffer and converting to lower case */
  293.     p = ptr;
  294.     while (*p && p <= &buf[71] ) {
  295.        *iptr = isupper(*p) ? tolower(*p) : *p;
  296.        iptr++;
  297.        p++;
  298.     }
  299.     *iptr = '\n';
  300.  
  301.     if ((ptr = look(line, "subroutine")) != 0 ||
  302.         (ptr = look(line, "function")) != 0 ||
  303.         (ptr = functs(line)) != 0) {
  304.         if(scan_name(s, ptr)) return(1);
  305.         strcpy( s, x);
  306.     } else if((ptr = look(line, "program")) != 0) {
  307.         if(scan_name(s, ptr)) return(1);
  308.         get_name( mainp, 4);
  309.         strcpy( s, mainp);
  310.     } else if((ptr = look(line, "blockdata")) != 0) {
  311.         if(scan_name(s, ptr)) return(1);
  312.         get_name( blkp, 6);
  313.         strcpy( s, blkp);
  314.     } else if((ptr = functs(line)) != 0) {
  315.         if(scan_name(s, ptr)) return(1);
  316.         strcpy( s, x);
  317.     } else {
  318.         get_name( mainp, 4);
  319.         strcpy( s, mainp);
  320.     }
  321.     return(1);
  322. }
  323.  
  324. scan_name(s, ptr)
  325. char *s, *ptr;
  326. {
  327.     char *sptr;
  328.  
  329.     /* scan off the name */
  330.     trim(ptr);
  331.     sptr = s;
  332.     while (*ptr != '(' && *ptr != '\n') {
  333.         if (*ptr != ' ' && *ptr != '\t')
  334.             *sptr++ = *ptr;
  335.         ptr++;
  336.     }
  337.  
  338.     if (sptr == s) return(0);
  339.  
  340.     *sptr++ = '.';
  341.     *sptr++ = 'f';
  342.     *sptr++ = 0;
  343.     return(1);
  344. }
  345.  
  346. char *functs(p)
  347. char *p;
  348. {
  349.         register char *ptr;
  350.  
  351. /*      look for typed functions such as: real*8 function,
  352.                 character*16 function, character*(*) function  */
  353.  
  354.         if((ptr = look(p,"character")) != 0 ||
  355.            (ptr = look(p,"logical")) != 0 ||
  356.            (ptr = look(p,"real")) != 0 ||
  357.            (ptr = look(p,"integer")) != 0 ||
  358.            (ptr = look(p,"doubleprecision")) != 0 ||
  359.            (ptr = look(p,"complex")) != 0 ||
  360.            (ptr = look(p,"doublecomplex")) != 0 ) {
  361.                 while ( *ptr == ' ' || *ptr == '\t' || *ptr == '*'
  362.             || (*ptr >= '0' && *ptr <= '9')
  363.             || *ptr == '(' || *ptr == ')') ptr++;
  364.         ptr = look(ptr,"function");
  365.         return(ptr);
  366.     }
  367.         else
  368.                 return(0);
  369. }
  370.  
  371. /*     if first 6 col. blank, return ptr to col. 7,
  372.     if blanks and then tab, return ptr after tab,
  373.     else return 0 (labelled statement, comment or continuation */
  374. char *skiplab(p)
  375. char *p;
  376. {
  377.     register char *ptr;
  378.  
  379.     for (ptr = p; ptr < &p[6]; ptr++) {
  380.         if (*ptr == ' ')
  381.             continue;
  382.         if (*ptr == '\t') {
  383.             ptr++;
  384.             break;
  385.         }
  386.         return (0);
  387.     }
  388.     return (ptr);
  389. }
  390.  
  391. /*     return 0 if m doesn't match initial part of s;
  392.     otherwise return ptr to next char after m in s */
  393. char *look(s, m)
  394. char *s, *m;
  395. {
  396.     register char *sp, *mp;
  397.  
  398.     sp = s; mp = m;
  399.     while (*mp) {
  400.         trim(sp);
  401.         if (*sp++ != *mp++)
  402.             return (0);
  403.     }
  404.     return (sp);
  405. }
  406.